home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / buffr2.zip / BGENHEAP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  6KB  |  218 lines
  1. Unit BGenHeap; {BufferedArray-Based Generic Heaps}
  2. {$R-,O+,S-}
  3. {$B-}
  4.     {*MUST* ensure Short-Circuit Boolean Evaluation!}
  5.  
  6. {Introduces the Generic Heap variant of the BufferedArray Object}
  7.  
  8. { BGenericHeaps are indexed 1..MaxElements, rather then 0..MaxElements-1 }
  9.  
  10. { BGenericHeaps are bigger than their MaxArray based cousins, but otherwise }
  11. { completely interchangeable.  NOTE: Even though Copy is implemented, I do  }
  12. { NOT anticipate it often being possible to use it!                         }
  13.  
  14. INTERFACE
  15.  
  16. Uses BuffAray,SrtFuncs,FlexPntr,Crt;
  17.  
  18. Type
  19.   BGenericHeap = Object (BufferedArray)
  20.  
  21.                 Greater : SortFunc;
  22.  
  23.                 Procedure Init (MaxElements : LongInt; ElementSize : Word;
  24.                                 MaxBuffSize : LongInt; FileName : String;
  25.                                 GreaterFunc : SortFunc);
  26.  
  27.                 { Accept, Retrieve, and Swap are only redefined to      }
  28.                 { implement the 1..MaxElement indexing needed for Heaps }
  29.  
  30.                 Procedure Accept (Var El; Index : LongInt; Size : Word);
  31.  
  32.                 Procedure Retrieve (Var El; Index : LongInt; Size : Word);
  33.  
  34.                 Procedure Swap (I,J : LongInt);
  35.  
  36.                 Procedure SiftDown (I,J : LongInt);
  37.  
  38.                                    { While I can think of No reason to  }
  39.                                    { Use SiftDown externally, there may }
  40.                                    { be a reason, so I have exported it }
  41.  
  42.                 Procedure SiftUp (Var El; Index : LongInt; Size : Word);
  43.  
  44.                                  { SiftUp can be used in place of Accept }
  45.                                  { In order to Create/Maintain a Heap as }
  46.                                  { a Heap while adding elements, thus    }
  47.                                  { allowing the use of Sort instead of   }
  48.                                  { HeapSort which structures a Heap by   }
  49.                                  { using BuildHeap.                      }
  50.  
  51.                 Procedure BuildHeap;
  52.  
  53.                                  { Creates the Heap structure from }
  54.                                  { the ground up.                  }
  55.  
  56.                 Procedure Sort;
  57.  
  58.                           { Sorts a Heap into Ascending order    }
  59.                           { Assumes HEAP is built or maintained. }
  60.  
  61.                 Procedure ChangeSort (NewSort : SortFunc);
  62.  
  63.                           { Permits the changing of sorting methods   }
  64.                           { such as might be required for sorting     }
  65.                           { records by a different field, for example }
  66.  
  67.                 { NOTE: This will require use of HeapSort to re-sort, }
  68.                 {       or BuildHeap to establish Priority Queue.     }
  69.  
  70.                 Procedure HeapSort;
  71.  
  72.                           { Sorts a Heap into Ascending order     }
  73.                           { Assumes nothing about Heap structure. }
  74.  
  75.                 Procedure Copy (From : BGenericHeap);
  76.  
  77.                           { Target Heap *MUST* be initialized  }
  78.                           { to EXACTLY same parameters as From }
  79.                           { with exception of FileName.        }
  80.  
  81.              End;
  82.  
  83.  
  84. IMPLEMENTATION
  85.  
  86. Procedure BGenericHeap.Init;
  87. Begin
  88.   Greater := GreaterFunc;
  89.   BufferedArray.Init (MaxElements,ElementSize,MaxBuffSize,FileName)
  90. End;
  91.  
  92. Procedure BGenericHeap.Accept (Var El; Index : LongInt; Size : Word);
  93. Begin
  94.   BufferedArray.Accept (El,Index-1,Size)
  95. End;
  96.  
  97. Procedure BGenericHeap.Retrieve (Var El; Index : LongInt; Size : Word);
  98. Begin
  99.   BufferedArray.Retrieve (El,Index-1,Size);
  100. End;
  101.  
  102. Procedure BGenericHeap.Swap (I,J : LongInt);
  103. Begin
  104.   BufferedArray.Swap (I-1,J-1)
  105. End;
  106.  
  107. Procedure BGenericHeap.SiftDown (I,J : LongInt);
  108. Var
  109.   K     : LongInt;
  110.   T1,T2 : FlexPtr;
  111. Begin
  112.   If I <= J Div 2  {J = "HeapLength"}
  113.     Then
  114.       Begin
  115.         GetMem (T1,SizeOf(FlexCount)+ElemSize);
  116.         GetMem (T2,SizeOf(FlexCount)+ElemSize);
  117.         If (1+2*I) > J
  118.           Then
  119.             K := 2*I
  120.           Else
  121.             Begin
  122.               Retrieve (T1^.Flex,2*I,ElemSize);
  123.               Retrieve (T2^.Flex,1+2*I,ElemSize);
  124.               If (Greater (T1^.Flex,T2^.Flex))
  125.                 Then
  126.                   K := 2*I
  127.                 Else
  128.                   K := 1+2*I
  129.             End;
  130.         Retrieve (T1^.Flex,K,ElemSize);
  131.         Retrieve (T2^.Flex,I,ElemSize);
  132.         If (Greater (T1^.Flex,T2^.Flex))
  133.           Then
  134.             Begin
  135.               Swap (K,I);
  136.               SiftDown (K,J)
  137.             End;
  138.         FreeMem (T1,SizeOf(FlexCount)+ElemSize);
  139.         FreeMem (T2,SizeOf(FlexCount)+ElemSize)
  140.       End
  141. End;
  142.  
  143. Procedure BGenericHeap.SiftUp (Var El; Index : LongInt; Size : Word);
  144. Var
  145.   J,K   : LongInt;
  146.   T1,T2 : FlexPtr;
  147. Begin
  148.   Accept (El,Index,Size);
  149.   If Index >= 2 Then
  150.     Begin
  151.       GetMem (T1,SizeOf(FlexCount)+ElemSize);
  152.       GetMem (T2,SizeOf(FlexCount)+ElemSize);
  153.       K := Index;
  154.       J := K Div 2;
  155.       Retrieve (T1^.Flex,K,ElemSize);
  156.       Retrieve (T2^.Flex,J,ElemSize);
  157.       While ((J > 0) and (Greater (T1^.Flex,T2^.Flex))) do
  158.         Begin
  159.           Swap (K,J);
  160.           K := J;
  161.           J := K Div 2;
  162.           If J > 0
  163.             Then
  164.               Begin
  165.                 Retrieve (T1^.Flex,K,ElemSize);
  166.                 Retrieve (T2^.Flex,J,ElemSize)
  167.               End
  168.         End;
  169.       FreeMem (T1,SizeOf(FlexCount)+ElemSize);
  170.       FreeMem (T2,SizeOf(FlexCount)+ElemSize)
  171.     End
  172. End;
  173.  
  174. Procedure BGenericHeap.BuildHeap;
  175. Var
  176.   I: LongInt;
  177. Begin
  178.   For I := MaxSize Div 2 DownTo 1 do SiftDown (I,MaxSize)
  179. End;
  180.  
  181. Procedure BGenericHeap.ChangeSort (NewSort : SortFunc);
  182. Begin
  183.   Greater := NewSort
  184. End;
  185.  
  186. Procedure BGenericHeap.Sort;  {Assumes HEAP is built or maintained}
  187. Var
  188.   I : LongInt;
  189. Begin
  190.   For I := MaxSize DownTo 2 do
  191.     Begin
  192.       Swap (1,I);
  193.  
  194.       {DELETE FOR PRODUCTION CODE}
  195.  
  196.       GoToXY (20,15);
  197.       Write (MaxSize-I+1);
  198.  
  199.       SiftDown (1,I-1)
  200.     End
  201. End;
  202.  
  203. Procedure BGenericHeap.HeapSort;
  204. Var
  205.   I : LongInt;
  206. Begin
  207.   BuildHeap;
  208.   Sort
  209. End;
  210.  
  211. Procedure BGenericHeap.Copy;
  212. Begin
  213.   Greater := From.Greater;
  214.   BufferedArray.Copy (From)
  215. End;
  216.  
  217. BEGIN
  218. END.